home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbmidi / vb_seq.bas < prev    next >
BASIC Source File  |  1995-02-04  |  29KB  |  955 lines
  1. Option Explicit
  2.  
  3. 'Type of recorded Midi Message
  4. Type udtMidiMsg
  5.     TimeStamp As Long   'Associated time in milliseconds
  6.     MidiData As Long    'Usually: (Status + Channel) + (&H100& * Data1) + (&H10000 * Data2)
  7. End Type
  8.  
  9. 'RecBuffer parameters
  10. Global aRecBuffer() As udtMidiMsg        'dynamic array of recorded messages
  11. Global nRecCounter As Long               'N. of recorded messages
  12. Global nRecErrors As Long                'N. of lost Midi In Messages
  13.  
  14. 'Timing variables
  15. Global lInitTime As Long        'timeGetTime() when Play or Rec starts (in Internal Sync)
  16. Global lOffsetTime As Long      'Display Time when Play or Rec starts (in Internal Sync)
  17.  
  18. 'Flags to track Play and Rec activity
  19. Global bStop As Integer     'if True indicates Stop Mode
  20. Global bPlay As Integer     'if True indicates Play Mode
  21. Global bRec As Integer      'if True indicates Rec Mode
  22.  
  23. 'For Clock displaying purposes  (incremented by one frame every frame)
  24. Global nDisplayHours As Integer
  25. Global nDisplayMinutes As Integer
  26. Global nDisplaySeconds As Integer
  27. Global nDisplayFrames As Integer
  28.  
  29. 'For MTC Out purposes   (incremented by two frames every two frames)
  30. Global nHoursCounter   As Integer
  31. Global nMinutesCounter As Integer
  32. Global nSecondsCounter As Integer
  33. Global nFramesCounter  As Integer
  34.  
  35. 'Name of the last saved or opened file
  36. Global sFilename As String
  37.  
  38. 'Visualize flags
  39. Global bVisualClock As Integer 'Visualize clock display
  40. Global bVisualData As Integer  'Visualize Midi Data Flow
  41. Global bVisualMtc As Integer   'Visualize MTC flow
  42.  
  43. 'To track Midi flow visualisation
  44. Global lMtcInTime As Long       'Time when MtcIn led was switched on
  45. Global lMtcOutTime As Long      'Time when MtcOut led was switched on
  46. Global lDataInTime As Long      'Time when DataIn led was switched on
  47. Global lDataOutTime As Long     'Time when DataOut led was switched on
  48.  
  49. 'Sequencer parameters
  50. Global nSeqChannel As Integer
  51. Global aSeqProgram(15) As Integer
  52.  
  53. 'Indicates Mouse state in Rewind and Forward MouseDown events
  54. Global bMouseDown As Integer
  55.  
  56. 'Led colors
  57. Global Const LED_OFF = &H80&
  58. Global Const LED_ON = &H80FF&
  59.  
  60. 'GENERAL CONSTANTS
  61.  
  62. 'MousePointer
  63. Global Const DEFAULT = 0
  64. Global Const HOURGLASS = 11
  65.  
  66. 'Keycodes
  67. Global Const KEY_ESCAPE = &H1B
  68. Global Const KEY_NUMPAD0 = &H60
  69. Global Const KEY_RETURN = &HD
  70. Global Const KEY_MULTIPLY = &H6A
  71. Global Const KEY_SPACE = &H20
  72. Global Const KEY_F12 = &H7B
  73.  
  74. 'Special keys
  75. Global Const SHIFT_MASK = 1
  76. Global Const CTRL_MASK = 2
  77. Global Const ALT_MASK = 4
  78.  
  79. ' MsgBox parameters
  80. Global Const MB_OK = 0                 ' OK button only
  81. Global Const MB_YESNO = 4              ' Yes and No buttons
  82. Global Const MB_ICONQUESTION = 32      ' Warning query
  83. Global Const MB_ICONEXCLAMATION = 48   ' Warning message
  84.  
  85. ' MsgBox return values
  86. Global Const IDOK = 1                  ' OK button pressed
  87. Global Const IDYES = 6                 ' Yes button pressed
  88. Global Const IDNO = 7                  ' No button pressed
  89.  
  90. 'Colors
  91. Global Const WHITE = &HFFFFFF
  92. Global Const DARKBLUE = &H800000
  93.  
  94. ' DragOver
  95. Global Const ENTER = 0
  96. Global Const LEAVE = 1
  97.  
  98. Sub Display_Erase ()
  99.     If frmVBSeq.lblHours <> "--" Then frmVBSeq.lblHours = "--"
  100.     If frmVBSeq.lblMinutes <> "--" Then frmVBSeq.lblMinutes = "--"
  101.     If frmVBSeq.lblSeconds <> "--" Then frmVBSeq.lblSeconds = "--"
  102.     If frmVBSeq.lblFrames <> "--" Then frmVBSeq.lblFrames = "--"
  103. End Sub
  104.  
  105. Sub Display_Show ()
  106.     Dim sDisplay As String
  107.  
  108.     sDisplay = Format$(nDisplayHours, "00")
  109.     If frmVBSeq.lblHours <> sDisplay Then frmVBSeq.lblHours = sDisplay
  110.  
  111.     sDisplay = Format$(nDisplayMinutes, "00")
  112.     If frmVBSeq.lblMinutes <> sDisplay Then frmVBSeq.lblMinutes = sDisplay
  113.  
  114.     sDisplay = Format$(nDisplaySeconds, "00")
  115.     If frmVBSeq.lblSeconds <> sDisplay Then frmVBSeq.lblSeconds = sDisplay
  116.  
  117.     sDisplay = Format$(nDisplayFrames, "00")
  118.     If frmVBSeq.lblFrames <> sDisplay Then frmVBSeq.lblFrames = sDisplay
  119. End Sub
  120.  
  121. Sub Dlg_Alert (sMsg As String)
  122.      Beep
  123.      MsgBox sMsg, MB_OK + MB_ICONEXCLAMATION, "ALERT"
  124. End Sub
  125.  
  126. Function Dlg_YesNo (sMsg1 As String) As Integer
  127.     Dim sMsg2 As String
  128.  
  129.     sMsg2 = "Make your decission"
  130.     Beep
  131.     If MsgBox(sMsg1, MB_YESNO + MB_ICONQUESTION, sMsg2) = IDYES Then
  132.         Dlg_YesNo = True
  133.     Else
  134.        Dlg_YesNo = False
  135.     End If
  136. End Function
  137.  
  138. 'Returns True if File must be deleted / False if File must not
  139. Function File_Delete% (sPath As String)
  140.     Dim i As Integer
  141.     Dim sName As String
  142.     Dim FNum As Integer
  143.  
  144.     If Len(sPath) <= 1 Or Mid$(sPath, Len(sPath), 1) = "\" Then
  145.     Call Dlg_Alert(sFilename & Chr(10) & "Bad file name!")
  146.     frmVBSeq.dlgFileDialog.Filename = "*.SNG"
  147.     sFilename = "?"
  148.     File_Delete = False
  149.     Exit Function
  150.     End If
  151.  
  152.     For i = Len(sPath) To 1 Step -1
  153.     If Mid$(sPath, i, 1) = "\" Then
  154.         sName = Mid$(sPath, i + 1, Len(sPath) - i)
  155.         Exit For
  156.     End If
  157.     Next i
  158.     
  159.     FNum = FreeFile
  160.  
  161.     On Error Resume Next
  162.  
  163.     Open sPath For Input As FNum
  164.  
  165.     'No error -> File already exists
  166.     If Err = 0 Then
  167.     If Dlg_YesNo(sName & " already exists!" & Chr(10) & "Replace it...?") = True Then
  168.         'overwrite it
  169.         File_Delete = True
  170.     Else
  171.         'abort save
  172.         File_Delete = False
  173.     End If
  174.  
  175.     'File not found
  176.     ElseIf Err = 53 Then
  177.     'doesn't need to be deleted
  178.     'keep on saving
  179.     File_Delete = True
  180.  
  181.     'Bad File Name
  182.     ElseIf Err = 64 Or Err = 52 Then
  183.     Call Dlg_Alert(sName & Chr(10) & "Bad file name!")
  184.     frmVBSeq.dlgFileDialog.Filename = "*.SNG"
  185.     sFilename = "?"
  186.     'abort save
  187.     File_Delete = False
  188.     
  189.     'Unexpected error
  190.     Else
  191.     Call Dlg_Alert("Error #" & Err & Chr(10) & Error$)
  192.     frmVBSeq.dlgFileDialog.Filename = "*.SNG"
  193.     sFilename = "?"
  194.     'abort save
  195.     File_Delete = False
  196.     End If
  197.  
  198.     Close FNum
  199. End Function
  200.  
  201. Sub File_Open ()
  202.     Dim FNum   As Integer
  203.     Dim nLen    As Integer
  204.     Dim i       As Integer
  205.     
  206.     'If buffer not empty confirm loss of data
  207.     If nRecCounter > 0 Then
  208.     If Dlg_YesNo("Erase recorded MIDI messages?") = False Then Exit Sub
  209.     End If
  210.  
  211.     On Error GoTo Open_Error_Handler
  212.  
  213.     'Activate cancel error
  214.     frmVBSeq.dlgFileDialog.CancelError = True
  215.  
  216.     'Set File Dialog parameters
  217.     frmVBSeq.dlgFileDialog.Filter = "Custom MIDI song (*.SNG)|*.SNG|Standard MIDI file (*.MID)|*.MID|All (*.*)|*.*"
  218.     frmVBSeq.dlgFileDialog.FilterIndex = 1
  219.     frmVBSeq.dlgFileDialog.DialogTitle = "Open File"
  220.     frmVBSeq.dlgFileDialog.Action = 1    '1 = Open file dialog
  221.  
  222.     frmVBSeq.Refresh
  223.  
  224.     'Get path and file name to be opened
  225.     sFilename = frmVBSeq.dlgFileDialog.Filename
  226.  
  227.     nLen = Len(sFilename)
  228.     For i = nLen To 1 Step -1
  229.     If Mid$(sFilename, i, 1) = "\" Then Exit For
  230.     Next i
  231.  
  232.     sFilename = Right$(sFilename, nLen - i)
  233.  
  234.     Screen.MousePointer = HOURGLASS
  235.  
  236.     If Right$(sFilename, 4) = ".SNG" Then
  237.     FNum = FreeFile
  238.     Open frmVBSeq.dlgFileDialog.Filename For Input As FNum
  239.     Input #FNum, nRecCounter
  240.     
  241.     If nRecCounter > 0 Then
  242.         ReDim aRecBuffer(nRecCounter + 1024 - (nRecCounter Mod 1024))
  243.         For i = 0 To nRecCounter - 1
  244.         Input #FNum, aRecBuffer(i).TimeStamp
  245.         Input #FNum, aRecBuffer(i).MidiData
  246.         Next i
  247.     End If
  248.     'Display recorded messages counter
  249.     frmVBSeq.lblRecMesNum = CStr(nRecCounter)
  250.     
  251.     Close #FNum
  252.     ElseIf Right$(sFilename, 4) = ".MID" Then
  253.     Call Dlg_Alert("Not implemented!")
  254.     Else
  255.     Call Dlg_Alert("Wrong file format!")
  256.     End If
  257.     
  258. Open_Exit:
  259.     Screen.MousePointer = DEFAULT
  260.     Exit Sub
  261.  
  262. Open_Error_Handler:
  263.     If Err = 32755 Then   'Cancel
  264.     Resume Open_Exit
  265.     Else
  266.     Call Dlg_Alert("Error #" & Err & Chr(10) & Error$)
  267.     Close #FNum
  268.     Resume Open_Exit
  269.     End If
  270.  
  271. End Sub
  272.  
  273. Sub File_Save ()
  274.     Dim sFname As String
  275.     Dim FNum As Integer
  276.     Dim i As Integer
  277.     Dim nStartName As Integer
  278.     Dim nLen As Integer
  279.  
  280.     'Exit if buffer empty
  281.     If nRecCounter = 0 Then
  282.     Call Dlg_Alert("Nothing to save!")
  283.     Exit Sub
  284.     End If
  285.  
  286.     On Error GoTo Save_Error_Handler
  287.  
  288.     'Activate cancel error
  289.     frmVBSeq.dlgFileDialog.CancelError = True
  290.  
  291.     'Set File Dialog parameters
  292.     f